#!/usr/bin/env perl
#
# Copyright (c) 2012-2013 Jeffrey M. Squyres.  All rights reserved.
#
# $COPYRIGHT$
# 
# Additional copyrights may follow
#
# Originally copied and adapted from the MPI Testing Tool (MTT)
# project: http://www.open-mpi.org/projects/mtt/, a BSD-licensed
# project.
#
# Copyright (c) 2005-2006 The Trustees of Indiana University.
#                         All rights reserved.
# Copyright (c) 2007      Cisco, Inc.  All rights reserved.
# Copyright (c) 2007-2009 Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 2010      Oracle and/or its affiliates.  All rights reserved.
# 
# See top-level LICENSE file for the copyrights from the MTT project.
#
# $HEADER$
#

package RubySlippers::Messages;

use strict;
use Text::Wrap;
use vars qw(@EXPORT);
use base qw(Exporter);
@EXPORT = qw(Messages Verbose Debug Warning DebugDump);

# Debug and verbose flags
my $_debug;
my $_verbose;
my $_log;

# Max length of string to pass to wrap() (it seems that at least some
# versions of wrap() handles Very Large strings and/or strings with
# Very Long lines extremely poorly -- it thrashes endlessly).
my $_max_wrap_len = 65536;


sub Messages {
    $_debug = shift;
    $_verbose = shift;
    $_log = shift;

    $Text::Wrap::columns = (9999);

    # Set autoflush
    if (!$_log) {
        select STDOUT;
        $| = 1;
    }
}

sub Warning {
    my $str = "@_";

    if ($_log) {
        _syslog("*** WARNING: $str");
    } else {
        if (length($str) < $_max_wrap_len) {
            print wrap("", "    ", "*** WARNING: $str\n");
        } else {
            print "*** WARNING: $str\n";
        }
    }
}


sub _make_prefix {
    my ($line, $func) = @_;
    $func =~ s/^RubySlippers:://;
    return "$func.$line";
}

sub _format {
    my $str = "@_";

    if ($_debug) {
	my @args = caller;
	my $line = $args[2];
	my @args = caller(1);
	my $str = _make_prefix($line, $args[3]) . ": @_";
    }

    if (length($str) < $_max_wrap_len) {
	return wrap("", "   ", $str);
    } else {
	return $str;
    }
}

sub DebugDump {
    if ($_debug) {
        my $d = new Data::Dumper([@_]);
        $d->Purity(1)->Indent(1);
        my $s = $d->Dump;
        print $s;
    }
}


sub Debug {
    if ($_debug) {
        my $str = _format(@_);
        if ($_log) {
            _syslog($str);
        } else {
            print "$str\n"
        }
    }
}


sub Verbose {
    if ($_verbose) {
	my $str = localtime . " " . _format(@_);
        if ($_log) {
            _syslog($str);
        } else {
            print "$str\n"
        }
    }
}

sub _syslog {
    if ($_log) {
        # system() sometimes hangs when we try to run logger :-(
        my $pid = fork();
        if (0 == $pid) {
            my @cmd = qw/logger -t rubyslippers/;
            push(@cmd, "@_");
            exec(@cmd);
            exit(1);
        }
        waitpid($pid, 0);
    }
}

1;
